home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Users Group Library 1996 July / C-C++ Users Group Library July 1996.iso / vol_200 / 297_02 / prunify.c < prev    next >
Encoding:
C/C++ Source or Header  |  1990-05-18  |  9.1 KB  |  306 lines
  1. /* prunify.c */
  2. /* structure sharing unification algorithm .
  3.  *  Occur check is a compilation option.
  4.  * Unification is Prolog's way of passing parameters, but the comparison
  5.  * is a little misleading.
  6.  * When you unify a goal and a clause head you need to distiguish 
  7.  * the variables so that even if they have the same name they are
  8.  * not the same variable. Variables in Prolog clauses are "local"
  9.  * after all. 
  10.  * This is why  Prolog objects never come alone,
  11.  * They come as pairs:
  12.  * node and (substitution) environment . 
  13.  * The latter says where to look up the values of the variables.
  14.  * When a goal is unified with a head their respective environments 
  15.  * are not the same.
  16.  * In the structure-sharing philosophy
  17.  * the substitutions are never really applied to modify the terms.
  18.  * This saves time in term building.
  19.  * Instead we use the environments to look up the values of the variables
  20.  * of the skeletons (which are pointers to parts of the original code)
  21.  * This adds the flesh. The disdavantage is that the algorithms may have to do
  22.  * a lot of pointer chasing to compare two terms in their respective
  23.  * environments. So the time we save in term building is spent in looking at 
  24.  * terms.
  25.  * A substitution frame consists of a sequence of substitutions.
  26.  * The nth substitution of the frame corresponds to the nth variable
  27.  * so the variable's offset can be used to get it directly.
  28.  */
  29. #include <stdio.h>
  30. #define NDEBUG 1 /* turn off checking */
  31. #include <assert.h>
  32.  
  33. /* #define DEBUG  */
  34. /* #define OCCUR_CHECK  if this is defined then unification is slower but 
  35.    checks to see that node1 is not inside node2. This occurs rarely and is
  36.    usually checked for in prolog's.
  37.  */
  38.  
  39. #include "prtypes.h"
  40.  
  41. extern int Trace_flag;
  42.  
  43. /* These are the globals modified by dereference() */
  44. node_ptr_t DerefNode;
  45. subst_ptr_t DerefSubst;
  46.  
  47. /******************************************************************************
  48.                   unify()
  49.  This routine tries to see if two terms (with their environments) can be
  50.  unified, ie can a substitution be applied to make the two terms equal?
  51.  ******************************************************************************/
  52. /* this would be probably faster if written in a non recursive way, and with
  53.  * in-line coding
  54.  */
  55. unify(node1ptr, subst1ptr, node2ptr, subst2ptr)
  56. node_ptr_t node1ptr, node2ptr; /* skeletons */
  57. subst_ptr_t subst1ptr, subst2ptr; /* environments */
  58. {
  59.     objtype_t type1, type2;
  60.  
  61.     type2 = NODEPTR_TYPE(node2ptr);
  62. #ifdef DEBUG
  63.     if(Trace_flag == 2){
  64.         tty_pr_string("Enter unify with arguments\n");
  65.         pr_node(node1ptr);
  66.         tty_pr_string(",\n");
  67.         pr_node(node2ptr);
  68.         tty_pr_string(",\n");
  69.     }
  70. #endif
  71.  
  72.     if(type2 == VAR)
  73.     {
  74.  
  75.         if(dereference(node2ptr, subst2ptr)) 
  76.         /* i.e. nodeptr is a bound variable */
  77.         {
  78.             node2ptr = DerefNode;
  79.             subst2ptr = DerefSubst;
  80.             type2 = NODEPTR_TYPE(node2ptr);
  81.             goto NODE2_NONVAR;
  82.         }
  83.         else /* node2ptr is free */
  84.         node2ptr = DerefNode;
  85.         subst2ptr = DerefSubst;
  86.  
  87.  
  88.  
  89. #define NODE1 DerefNode /* so as to avoid useless assignments */
  90. #define SUBST1 DerefSubst
  91.  
  92.         if(!dereference(node1ptr, subst1ptr))/* it's free */
  93.         {
  94.             if (subst2ptr < SUBST1)
  95.             {
  96.                 return(bind_var(NODE1,SUBST1, node2ptr, subst2ptr));
  97.             }
  98.             else    /* is it the same variable ? */
  99.                 if(SUBST1 == subst2ptr && 
  100.                     NODEPTR_OFFSET(node2ptr) == NODEPTR_OFFSET(NODE1))
  101.                     return(TRUE);/* dont bind a var to itself */
  102.                 else
  103.                     return(bind_var(node2ptr, subst2ptr, NODE1, SUBST1));
  104.         }
  105.         return(bind_var(node2ptr, subst2ptr, NODE1, SUBST1));
  106.  
  107.     }
  108. NODE2_NONVAR:
  109.     assert(NODEPTR_TYPE(node2ptr) != VAR);
  110.     type1 = NODEPTR_TYPE(node1ptr);
  111.  
  112.     switch(type1)
  113.     {
  114.     case ATOM:
  115.         if(type1 != type2)return(FALSE);
  116.         return(NODEPTR_ATOM(node1ptr) == NODEPTR_ATOM(node2ptr));
  117.  
  118.     case VAR:
  119.         
  120.         if(dereference(node1ptr, subst1ptr))
  121.         { /* node1 is a bound variable */
  122.             node1ptr = DerefNode; /* what it's bound to */
  123.             subst1ptr = DerefSubst;
  124.             goto NODE2_NONVAR; 
  125.         }
  126.         else
  127.         return(bind_var(DerefNode, DerefSubst,node2ptr,subst2ptr));
  128.  
  129.     case STRING:
  130.         if(type1 != type2)return(FALSE);
  131.         return(!strcmp(NODEPTR_STRING(node1ptr), NODEPTR_STRING(node2ptr)));
  132.  
  133.     case INT:
  134.         if(type1 != type2)return(FALSE);
  135.         return(NODEPTR_INT(node1ptr) == NODEPTR_INT(node2ptr));
  136.  
  137.     case PAIR:
  138.         if(type1 != type2)return(FALSE);
  139.         /* to oversimplify: 
  140.          unify each of the corresponding elements of the lists
  141.              and fail if one of them does not unify.
  142.         */
  143.         while(NODEPTR_TYPE(node1ptr) == PAIR && NODEPTR_TYPE(node2ptr)== PAIR)
  144.         {
  145.             if(!unify(NODEPTR_HEAD(node1ptr), subst1ptr, 
  146.                 NODEPTR_HEAD(node2ptr), subst2ptr))return(FALSE);
  147.  
  148.             dereference(NODEPTR_TAIL(node1ptr), subst1ptr);
  149.             node1ptr = DerefNode;
  150.             subst1ptr = DerefSubst;
  151.  
  152.             dereference(NODEPTR_TAIL(node2ptr), subst2ptr);
  153.             node2ptr = DerefNode;
  154.             subst2ptr = DerefSubst;
  155.         }
  156.  
  157.         return(unify(node1ptr, subst1ptr, node2ptr, subst2ptr));
  158.  
  159.     case CLAUSE:
  160.         if(type1 != type2)return(FALSE);
  161.         else/* compare pointers only ! */
  162.         return(NODEPTR_CLAUSE(node2ptr) == NODEPTR_CLAUSE(node1ptr));
  163. #ifdef REAL
  164.     case REAL:
  165.         if(type1 != type2)return(FALSE);
  166.         return(NODEPTR_REAL(node1ptr) == NODEPTR_REAL(node2ptr));
  167. #endif    
  168.  
  169. #ifdef CHARACTER    
  170.     case CHARACTER:
  171.         if(type1 != type2)return(FALSE);
  172.         else
  173.             return(NODEPTR_CHARACTER(node2ptr) == NODEPTR_CHARACTER(node1ptr));
  174. #endif
  175.     default:
  176.         INTERNAL_ERROR("unification type");
  177.         return(FALSE);
  178.     }
  179.  
  180. }
  181.  
  182. /******************************************************************************
  183.             bind_var()
  184.  Set the "value" of node1ptr, subst1ptr to node2ptr, subst2ptr.
  185.  node1ptr must be an unbound var in its environement subst1ptr.
  186.  ******************************************************************************/
  187. bind_var(node1ptr, subst1ptr, node2ptr, subst2ptr)
  188. node_ptr_t node1ptr, node2ptr;
  189. subst_ptr_t subst1ptr, subst2ptr;
  190. {
  191.     char *molec; /* yes, a char * (for efficiency) */
  192.     node_ptr_t **my_Trail_alloc(), **trailptr;
  193.  
  194. #ifndef NDEBUG
  195.     if(NODEPTR_TYPE(node1ptr) != VAR)INTERNAL_ERROR("non var bind");
  196. #endif 
  197. #ifdef OCCUR_CHECK
  198.     if(occur_check(node1ptr, subst1ptr, node2ptr, subst2ptr))
  199.     {
  200.         errmsg("occur check returns true!");
  201.         return 0;
  202.     }
  203. #endif
  204.     molec = (char *)subst1ptr + NODEPTR_OFFSET(node1ptr);
  205.     ((subst_ptr_t)molec)->frame = subst2ptr;
  206. #ifndef NDEBUG
  207.     if(((subst_ptr_t)molec)->skel)INTERNAL_ERROR("noise in molecule");
  208. #endif 
  209.     ((subst_ptr_t)molec)->skel = node2ptr;
  210.  
  211.     /* record the substitution on the trail so that it can be 
  212.        undone later
  213.       (this might not always be necessary) 
  214.     */
  215.     trailptr = my_Trail_alloc();
  216.     *trailptr = &(((subst_ptr_t)molec)->skel);
  217.     return 1;
  218. }
  219.  
  220. /******************************************************************************
  221.             reset_trail()
  222. Use the trail to reset the substitution stack.
  223.  ******************************************************************************/
  224. reset_trail(from)
  225. node_ptr_t **from;
  226. {
  227.     register node_ptr_t **tp;
  228.     extern node_ptr_t **Trail_ptr;
  229.  
  230.     for(tp = from; tp < Trail_ptr; tp++)
  231.     {
  232.         **tp = NULL;
  233.     }
  234.     Trail_ptr = from;
  235. }
  236.  
  237. /*****************************************************************************
  238.             dereference()
  239. Lookup what a variable points to indirectly.
  240. Dereferencing is weaker than instantiating, because the variables in
  241. the dereferenced term are not replaced by their values, if you want
  242. to know their values you have to derefence them and so on. See how
  243. the display builtin works to give you the impression that it is
  244. printing the instantiated term.
  245. Returns 0 if nodeptr dereferences to (in fact instantiates to) VAR 
  246. and 1 otherwise, ie returns 0 if (nodepr,substptr) is free
  247.  *****************************************************************************/
  248. /* updates DerefNode, DerefSubst */
  249. dereference(nodeptr, substptr)
  250. node_ptr_t nodeptr;
  251. subst_ptr_t substptr;
  252. {
  253.     char *molec;/* a bit of finesse is needed here to gain speed */
  254.     node_ptr_t skelptr;
  255.     DerefNode = nodeptr;
  256.     DerefSubst = substptr;
  257.  
  258.     while(NODEPTR_TYPE(DerefNode) == VAR)
  259.     {
  260.         molec = (char *)DerefSubst + NODEPTR_OFFSET(DerefNode);
  261.         /* we converted to char * to avoid behind-the-scenes offset multiplication */
  262.         skelptr = ((subst_ptr_t)molec)->skel;
  263.         if(!skelptr)
  264.             return(FALSE);
  265.         else
  266.             DerefNode = skelptr;
  267.         DerefSubst = ((subst_ptr_t)molec)->frame;
  268.     }
  269.     return(TRUE);
  270. }
  271.  
  272. /******************************************************************************
  273.             occur_check()
  274.  ******************************************************************************/
  275. #ifdef OCCUR_CHECK
  276. occur_check(node1ptr, subst1ptr, node2ptr, subst2ptr)
  277. node_ptr_t node1ptr, node2ptr;
  278. subst_ptr_t subst1ptr, subst2ptr;
  279. {
  280.  
  281.     if(NODEPTR_TYPE(node2ptr) == VAR)
  282.     {
  283.         if(    subst1ptr == subst2ptr &&
  284.             (NODEPTR_OFFSET(node2ptr) == NODEPTR_OFFSET(node1ptr))
  285.             )return 1;
  286.         else
  287.             return 0;
  288.     }
  289.     else
  290.         if(NODEPTR_TYPE(node2ptr) == PAIR)
  291.         {
  292.             dereference(NODEPTR_HEAD(node2ptr), subst2ptr);
  293.             if(occur_check(node1ptr, subst1ptr, DerefNode, DerefSubst))
  294.                 return 1;
  295.             else
  296.             {
  297.                 dereference(NODEPTR_TAIL(node2ptr), subst2ptr);
  298.                 return(occur_check(node1ptr, subst1ptr, DerefNode, DerefSubst));
  299.             }
  300.         }
  301.     return(0);
  302. }
  303. #endif
  304.  
  305. /* end of file */
  306.